Carousel Volume 2 #1/carousel.iso/mactosh/lang/p_image1.sit/LSP Source/Camera.p

Text File | 1989-07-12 | 16.7 KB | 637 lines

unit Camera;

{Routines used by the Image program for supporting the Data Translation}
{QuickCapture card and the Scion Image Capture 2.}

interface


    uses
        QuickDraw, OSIntf, PickerIntf, PrintTraps, ToolIntf, globals, Utilities, Graphics, FileUnit;


    procedure AverageFrames;
    procedure GetFrame; {From QuickCapture}
    procedure StartDigitizing;
    procedure StopDigitizing;
    procedure SetVideoChannel;



implementation

    procedure CorrectShadingOfLine (PicPtr, BFPtr: ptr; width, BFMean: integer);
{}
{TYPE}
{  lptr=^LineType;}
{VAR}
{  PicLine,BFLine:lptr;}
{  i,value:integer;}
{BEGIN}
{  PicLine:=lptr(PicPtr);}
{  BFLine:=lptr(BFPtr);}
{  FOR i:=0 TO width-1 DO BEGIN}
{    value:=PicLine^[i];}
{    value:=255-value;}
{    value:=(LongInt(value)*BFMean+(BFLine^[i] DIV 2)) DIV BFLine^[i];}
{    IF value>254 THEN value:=254;}
{    IF value<1 THEN value:=1;}
{    PicLine^[i]:=255-value;}
{  END;}
{  }
  {a0=data pointer}
  {a1=blank field data pointer}
  {d0=count}
  {d1=pixel value}
  {d2=blank field pixel value}
  {d3=blank field mean}
  {d4=temp}
  {d5=max pixel value(245)}
  {d6=min pixel value(1)}
    inline
        $4E56, $0000, {   link    a6,#0}
        $48E7, $FEC0, {   movem.l    a0-a1/d0-d6,-(sp)}
        $206E, $000C, {   move.l    12(a6),a0}
        $226E, $0008, {   move.l    8(a6),a1}
        $4280,       {   clr.l    d0}
        $302E, $0006, {   move.w    6(a6),d0}
        $362E, $0004, {   move.w    4(a6),d3}
        $2A3C, $0000, $00FE, {   move.l    #254,d5}
        $2C3C, $0000, $0001, {   move.l    #1,d6}
        $5380,       {   subq.l    #1,d0}
        $4281,       {   clr.l    d1}
        $4282,       {   clr.l    d2}
        $1210,       {L1    move.b    (a0),d1}
        $1419,       {   move.b    (a1)+,d2}
        $4601,       {   not.b    d1}
        $C2C3,       {   mulu.w    d3,d1}
        $2802,       {   move.l    d2,d4}
        $E244,       {   asr.w    #1,d4}
        $D284,       {   add.l    d4,d1}
        $82C2,       {   divu.w    d2,d1}
        $B245,       {   cmp.w    d5,d1}
        $6F02,       {   ble.s    L2}
        $3205,       {   move.w    d5,d1}
        $B246,       {L2    cmp.w    d6,d1}
        $6C02,       {   bge.s    L3}
        $3206,       {   move.w    d6,d1}
        $4601,       {L3    not.b    d1}
        $10C1,       {   move.b    d1,(a0)+}
        $51C8, $FFDE, {   dbra    d0,L1}
        $4CDF, $037F, {   movem.l    (sp)+,a0-a1/d0-d6}
        $4E5E,       {   unlk    a6}
        $DEFC, $000C; {   add.w    #12,sp}
{END;}


    procedure CorrectShading;
        var
            i: integer;
            offset: LongInt;
            p1, p2: ptr;
    begin
        with info^ do begin
                if PicSize <> BlankFieldInfo^.PicSize then begin
                        beep;
                        exit(CorrectShading);
                    end;
                ShowWatch;
                p1 := PicBaseAddr;
                p2 := BlankFieldInfo^.PicBaseAddr;
                for i := 1 to nLines do begin
                        CorrectShadingOfLine(p1, p2, PixelsPerLine, BlankFieldMean);
                        p1 := ptr(ord4(p1) + info^.BytesPerRow);
                        p2 := ptr(ord4(p2) + BlankFieldInfo^.BytesPerRow);
                        if i mod 96 = 0 then
                            UpdatePicWindow;
                    end;
                UpdatePicWindow;
                SetWTitle(wptr, 'Camera(Corrected)');
            end;
    end;


    procedure GetFrame; {From QuickCapture}
        var
            tPort: GrafPtr;
    begin
        if info = NoInfo then
            exit(GetFrame);
        GetPort(tPort);
        with info^ do begin
                if (PictureType <> Camera) or (PixelsPerLine <> 640) or (nlines <> 480) then
                    exit(GetFrame);
                ControlReg^ := BitAnd($80, 255); {Start frame capture}
                while ControlReg^ < 0 do
                    ;       {Wait for it to complete}
                UpdatePicWindow;
            end;
        SetPort(tPort);
    end;


    procedure SetReg (index, value: integer);
        const
            RegOffset = $f5fe0;
        var
            reg: ptr;
    begin
        reg := ptr(ScionSlotBase + RegOffset + index * 4);
        reg^ := value;
    end;


    procedure ResetScion (GrabRect: rect; DisplayPoint: point);
        const
            ilutOffset = $f0000;
            LineStartsRamOffset = $f4000;
        type
            LineStartsArray = packed array[0..8191] of UnsignedByte;
            LineStartsType = ^LineStartsArray;
        var
            ScreenRowBytesx2: LongInt;
            LutPtr: ptr;
            LineStarts: LineStartsType;
            EvenStart, OddStart: LongInt;
            width, height, IndexOdd, IndexEven, index, i: integer;
            hstart, vstart: integer;
    begin
        ScreenRowBytesx2 := ScreenRowBytes * 2;
        LoadInputLookupTable(Ptr(ScionSlotBase + ilutOffset));
        with GrabRect, DisplayPoint do begin
                hstart := BitAnd(left, $fffc);
                vstart := BitAnd(top, $fffe);
                width := right - left;
                height := bottom - top;
                EvenStart := LongInt(ScreenBase) + h + ScreenRowBytes * v;
                OddStart := EvenStart + ScreenRowBytes;
                IndexOdd := 0;
                IndexEven := (height div 2) * 16;
            end;
        LineStarts := LineStartsType(ScionSlotBase + LineStartsRamOffset);
        for i := 1 to height div 2 do begin
                LineStarts^[IndexOdd] := BSR(BitAnd(OddStart, $ff000000), 24);
                LineStarts^[IndexOdd + 4] := BSR(BitAnd(OddStart, $ff0000), 16);
                LineStarts^[IndexOdd + 8] := BSR(BitAnd(OddStart, $ff00), 8);
                LineStarts^[IndexOdd + 12] := BitAnd(OddStart, $fc);
                LineStarts^[IndexEven] := BSR(BitAnd(EvenStart, $ff000000), 24);
                LineStarts^[IndexEven + 4] := BSR(BitAnd(EvenStart, $ff0000), 16);
                LineStarts^[IndexEven + 8] := BSR(BitAnd(EvenStart, $ff00), 8);
                LineStarts^[IndexEven + 12] := BitAnd(EvenStart, $fc);
                IndexOdd := IndexOdd + 16;
                IndexEven := IndexEven + 16;
                OddStart := OddStart + ScreenRowBytesx2;
                EvenStart := EvenStart + ScreenRowBytesx2;
            end;
        Index := height * 16;
        LineStarts^[Index] := 0;
        LineStarts^[Index + 4] := 0;
        LineStarts^[Index + 8] := 0;
        LineStarts^[Index + 12] := 1;
        SetReg(1, 0);
        SetReg(2, 162 - (width div 4));
        SetReg(3, 0);
        SetReg(4, 225 - (hstart div 4));
        SetReg(5, 255 - (width div 4));
        SetReg(6, 241 - (vstart div 2));
        SetReg(7, 255 - (height div 2));
    end;


    procedure GetScionFrame (DisplayPoint: point);
        type
            IntPtr = ^integer;
        var
            FlagLoc: IntPtr;
            StartTime: LongInt;
    begin
        with DisplayPoint do
            FlagLoc := IntPtr(LongInt(ScreenBase) + h + ScreenRowBytes * v + 4);
        FlagLoc^ := $00ff;
        StartTime := TickCount;
        SetReg(1, BitOr(128, VideoChannel * 4)); {Grab Enable}
        while FlagLoc^ = $00ff do
            if TickCount > (StartTime + 60) then begin
                    SetReg(1, 0); {Stop Grabbing}
                    exit(GetScionFrame)
                end;
        SetReg(1, 0); {Stop Grabbing}
    end;


    function GetScreenPixel (h, v: integer): integer;
        var
            offset: LongInt;
            p: ptr;
    begin
        offset := LongInt(v) * ScreenRowBytes + h;
        p := ptr(ord4(ScreenBase) + offset);
        GetScreenPixel := BAND(p^, 255);
    end;


    procedure DoMiniEventLoop (FullScreenMode: boolean);
        var
            loc: point;
            event: EventRecord;
    begin
        FlushEvents(EveryEvent, 0);
        if not FullScreenMode then begin
                ValuesMode := PixelValues;
                DrawLabels;
            end;
        repeat
            GetMouse(loc);
            LocalToGlobal(loc);
            if not FullScreenMode then
                with loc do
                    Show3RealValues(h, v, GetScreenPixel(h, v));
        until GetNextEvent(mDownMask + KeyDownMask, Event);
    end;


    procedure CaptureUsingScion;
        var
            GrabRect: rect;
            DisplayPoint: point;
            FullScreenMode: boolean;
            wwidth, wheight: integer;
            tPort: GrafPtr;
            SaveBackgroundColor, hstart, vstart, line: integer;
            src, dst: ptr;
            ignore: integer;
            mloc: point;
    begin
        FullScreenMode := OptionKeyDown and (ScreenWidth = 640);
        if FullScreenMode or (ScreenWidth > 640) then begin
                wwidth := MaxScionWidth;
                wheight := 480
            end
        else begin
                wwidth := 552;
                if wwidth > MaxScionWidth then
                    wwidth := MaxScionWidth;
                wheight := 436;
            end;
        if ScionInfo <> nil then
            with ScionInfo^.wrect, ScionInfo^ do
                if (wwidth <> right) or (wheight <> bottom) then begin
                        changes := false;
                        ignore := CloseAWindow(wptr);
                    end;
        if (ScionInfo <> nil) and (info^.PictureType <> ScionType) then begin
                SelectWindow(ScionInfo^.wptr);
                info := ScionInfo;
            end;
        if ScionInfo <> nil then
            BringToFront(ScionInfo^.wptr);
        with info^ do
            if PictureType <> ScionType then begin
                    if not NewPicWindow('Camera(Scion)', wwidth, wheight) then begin
                            beep;
                            exit(CaptureUsingScion)
                        end;
                    ScionInfo := info;
                end;
        KillRoi;
        with info^ do begin
                PictureType := ScionType;
                changes := true;
                SetWTitle(wptr, 'Camera(Live)');
            end;
        hstart := (640 - wwidth) div 2;
        vstart := (480 - wheight) div 2;
        SetRect(GrabRect, hstart, vstart, hstart + wwidth, vstart + wheight);
        if FullScreenMode then
            with DisplayPoint do begin
                    h := BitAnd((640 - wwidth) div 2, $fffc);
                    v := 0;
                end
        else
            with DisplayPoint do begin
                    h := PicWindowLeft;
                    v := PicWindowTop;
                end;
        ResetScion(GrabRect, DisplayPoint);
        if FullScreenMode then begin
                GetPort(tPort);
                SaveBackgroundColor := BackgroundColor;
                SetBackgroundColor(BlackC);
                EraseScreen;
            end;
        with info^ do begin
                if magnification <> 1.0 then
                    Unzoom;
                SetReg(1, BitOr(128, VideoChannel * 4)); {Grab Enable}
                DoMiniEventLoop(FullScreenMode);
                SetReg(1, 0);   {Stop Grabbing}
                HideCursor;
                GetScionFrame(DisplayPoint);
                with DisplayPoint do
                    src := ptr(LongInt(ScreenBase) + h + ScreenRowBytes * v);
                with SrcRect do
                    dst := ptr(LongInt(PicBaseAddr) + left + BytesPerRow * top);
                for line := 1 to wheight do begin
                        BlockMove(src, dst, wwidth);
                        src := ptr(ord4(src) + ScreenRowBytes);
                        dst := ptr(ord4(dst) + BytesPerRow);
                    end;
                ShowCursor;
            end;
        if FullScreenMode then begin
                RestoreScreen;
                SetBackgroundColor(SaveBackgroundColor);
                SetPort(tPort);
            end;
        SetWTitle(info^.wptr, 'Camera');
        if (BlankFieldInfo <> nil) and not OptionKeyDown then
            CorrectShading;
        FlushEvents(EveryEvent, 0);
    end;


    procedure StartDigitizing;
        var
            i: integer;
    begin
        if FrameGrabber = Scion then begin
                CaptureUsingScion;
                exit(StartDigitizing)
            end;
        if Digitizing then begin
                StopDigitizing;
                if BlankFieldInfo <> nil then
                    wait(15);
                FlushEvents(EveryEvent, 0); {In case user holds key down too long}
                exit(StartDigitizing)
            end;
        if FrameGrabber = NoFrameGrabber then begin
                PutMessage('Digitizing Requires a Data Translation or SCION frame grabber card.', '', '');
                exit(StartDigitizing)
            end;
        if (CameraInfo <> nil) and (info^.PictureType <> camera) then begin
                SelectWindow(CameraInfo^.wptr);
                info := CameraInfo;
            end;
        with info^ do
            if (PictureType <> Camera) or (PixelsPerLine <> 640) or (nlines <> 480) then
                if not NewPicWindow('Camera', 640, 480) then begin
                        beep;
                        exit(StartDigitizing)
                    end;
        KillRoi;
        ResetQuickCapture;
        Digitizing := true;
        ContinuousHistogram := false;
        SetItem(FunctionsMenuH, StartItem, 'Stop Digitizing');
        with info^ do begin
                changes := true;
                SetWTitle(wptr, 'Camera(Live)');
            end;
    end;


    procedure AddLineToSum (src, dst: ptr; width: LongInt);
{$IFC false}
        type
            SumLineType = array[0..2047] of integer;
            fptr = ^SumLineType;
            lptr = ^LineType;
        var
            FrameLine: lptr;
            SumLine: fptr;
            i: integer;
    begin
        FrameLine := lptr(src);
        SumLine := fptr(dst);
        for i := 0 to width - 1 do
            SumLine^[i] := SumLine^[i] + FrameLine^[i];
    end;
{$ENDC}
inline
{a0=data pointer}
{a1=sum buffer pointer}
{d0=count}
{d1=pixel value}
{d2=temp}
    $4E56, $0000, {link    a6,#0}
    $48E7, $E0C0, {movem.l    a0-a1/d0-d2,-(sp)}
    $206E, $000C, {move.l    12(a6),a0}
    $226E, $0008, {move.l    8(a6),a1}
    $202E, $0004, {move.l    4(a6),d0}
    $5380,              {subq.l    #1,d0}
    $4281,              {clr.l    d1}
    $4282,              {clr.l    d2}
    $1218,              {L1    move.b    (a0)+,d1}
    $3411,              {move.w    (a1),d2}
    $D441,              {add.w      d1,d2}
    $32C2,              {move.w    d2,(a1)+}
    $51C8, $FFF6, {dbra    d0,L1}
    $4CDF, $0307, {movem.l    (sp)+,a0-a1/d0-d2}
    $4E5E,               {unlk    a6}
    $DEFC, $000C; {add.w    #12,sp}



procedure AverageFrames;
    type
        IntPtr = ^integer;
        SumLineType = array[0..2047] of integer;
        sptr = ^SumLineType;
        lptr = ^LineType;
    var
        AutoSelectAll: boolean;
        SelectionSize, FrameBufferSize, offset: LongInt;
        SumBase, src, srcbase, dst, OffscreenBase: ptr;
        str1, str2: str255;
        xLines, xPixelsPerLine, xPixelsPerLine2, frame, line, pixel: integer;
        aline: LineType;
        GrabRect: rect;
        DisplayPoint: point;
        hstart, vstart, wwidth, wheight, MinV, MaxV, value: integer;
        j, range, FramesAveraged: integer;
        SrcRowBytes, DstRowBytes, i: LongInt;
        SumFrames: boolean;
        iptr: IntPtr;
        FrameLine: lptr;
        SumLine: sptr;

    procedure Quit;
    begin
        if AutoSelectAll or (BlankFieldInfo <> nil) then
            KillRoi
        else
            ShowRoi;
        if digitizing then
            StopDigitizing
        else if BlankFieldInfo <> nil then
            CorrectShading;
    end;

begin
    SumFrames := OptionKeyDown;
    ValuesMode := CountValues;
    DrawLabels;
    if (info <> CameraInfo) and (info <> ScionInfo) then begin
            PutMessage('You must have an active Camera window(created using Start Digitizing) ', 'in order to average frames.', '');
            exit(AverageFrames)
        end;
    if NotRectangular or NotinBounds then
        exit(AverageFrames);
    ShowWatch;
    AutoSelectAll := not Info^.RoiShowing;
    if AutoSelectAll then
        SelectAll(false);
    with info^.osroiRect do
        SelectionSize := (LongInt(right) - left) * (bottom - top);
    FrameBufferSize := SelectionSize * 2;
    if FrameBufferSize > BigBufSize then begin
            NumToString(FrameBufferSize div 1024, str1);
            NumToString(BigBufSize div 1024, str2);
            str2 := concat(str1, 'K bytes are required, but only ', str2, 'K bytes are available.');
            PutMessage('There is not enough memory to do the requested frame averaging. ', str2, '');
            if AutoSelectAll or (BlankFieldInfo <> nil) then
                KillRoi
            else
                ShowRoi;
            exit(AverageFrames)
        end;
    WhatToUndo := NothingToUndo;
    WhatsOnClip := Nothing;
    SumBase := BigBuf;
    if FrameGrabber = QuickCapture then
        ResetQuickCapture
    else begin
            with info^.wrect do begin
                    wwidth := right;
                    wheight := bottom;
                end;
            hstart := (640 - wwidth) div 2;
            vstart := (480 - wheight) div 2;
            SetRect(GrabRect, hstart, vstart, hstart + wwidth, vstart + wheight);
            with DisplayPoint do begin
                    h := PicWindowLeft;
                    v := PicWindowTop;
                end;
            ResetScion(GrabRect, DisplayPoint);
        end;
    with info^, info^.osroirect do begin
            offset := left + LongInt(top) * BytesPerRow;
            OffscreenBase := ptr(ord4(PicBaseAddr) + offset);
            if FrameGrabber = QuickCapture then begin
                    srcbase := OffscreenBase;
                    SrcRowBytes := BytesPerRow;
                end
            else
                with DisplayPoint do begin
                        BringToFront(wptr);
                        offset := left + h + (v + top) * ScreenRowBytes;
                        srcbase := ptr(ord4(ScreenBase) + offset);
                        SrcRowBytes := ScreenRowBytes;
                    end;
            xLines := bottom - top;
            xPixelsPerLine := right - left;
            xPixelsPerLine2 := xPixelsPerLine * 2;
        end;
    dst := SumBase;
    for line := 1 to xLines do begin {zero buffer}
            BlockMove(@BlankLine, dst, xPixelsPerLine2);
            dst := ptr(ord4(dst) + xPixelsPerLine2);
        end;
    for frame := 0 to nFrames - 1 do begin
            Show2Values(frame + 1, nframes);
            if FrameGrabber = QuickCapture then begin
                    ControlReg^ := BitAnd($80, 255); {Start frame capture}
                    while ControlReg^ < 0 do
                        ;       {Wait for it to complete}
                end
            else
                GetScionFrame(DisplayPoint);
            src := srcbase;
            dst := SumBase;
            for line := 1 to xLines do begin
                    AddLineToSum(src, dst, xPixelsPerLine);
                    src := ptr(ord4(src) + SrcRowBytes);
                    dst := ptr(ord4(dst) + xPixelsPerLine2);
                end;
            if FrameGrabber = QuickCapture then
                UpdateScreen(info^.roiRect);
            if CommandPeriod then begin
                    beep;
                    exit(AverageFrames);
                end;
        end;
    src := SumBase;
    dst := OffscreenBase;
    DstRowBytes := info^.BytesPerRow;
    if SumFrames then begin
            MinV := 32767;
            MaxV := 0;
            iptr := IntPtr(src);
            for i := 1 to SelectionSize do begin
                    value := iptr^;
                    if value > MaxV then
                        MaxV := value;
                    if value < MinV then
                        MinV := value;
                    iptr := IntPtr(ord4(iptr) + 2);
                end;
            range := MaxV - MinV;
            if range <> 0 then
                for line := 1 to xLines do begin
                        SumLine := sptr(src);
                        FrameLine := lptr(dst);
                        for j := 0 to xPixelsPerLine - 1 do begin
                                value := SumLine^[j] - MinV + 1;
                                value := LongInt(value) * 254 div range;
                                FrameLine^[j] := value;
                            end;
                        src := ptr(ord4(src) + xPixelsPerLine2);
                        dst := ptr(ord4(dst) + DstRowBytes);
                    end
            else
                beep;
        end
    else
        for line := 1 to xLines do begin
                SumLine := sptr(src);
                FrameLine := lptr(dst);
                for j := 0 to xPixelsPerLine - 1 do
                    FrameLine^[j] := SumLine^[j] div nFrames;
                src := ptr(ord4(src) + xPixelsPerLine2);
                dst := ptr(ord4(dst) + DstRowBytes);
            end;
    UpdatePicWindow;
    Quit;
end;


procedure StopDigitizing;
begin
    if digitizing then begin
            SetItem(FunctionsMenuH, StartItem, 'Start Digitizing');
            Digitizing := false;
            with info^ do
                if PictureType = camera then
                    SetWTitle(wptr, 'Camera');
            if (BlankFieldInfo <> nil) and not OptionKeyDown then
                CorrectShading;
        end;
end;


procedure SetVideoChannel;
    var
        TempChannel: integer;
begin
    if FrameGrabber = Scion then begin
            TempChannel := GetInt('Scion Input Channel(1..4):', VideoChannel + 1);
            TempChannel := TempChannel - 1;
        end
    else
        TempChannel := GetInt('QuickCapture Input Channel(0..3):', VideoChannel);
    if (TempChannel >= 0) and (TempChannel <= 3) then
        VideoChannel := TempChannel;
end;

end.